00100	ENTRY DUMMY;
00200	BEGIN	"DPY"
00300	
00400		REQUIRE "ABBREV" SOURCE_FILE;
00500		REQUIRE "GEOMES" SOURCE_FILE;
00600		DEFINE β="";
00700	
00800	α OCCULT'S CONTEXT - FACE AND EDGE RINGS;
00900	
01000		INTERNAL INTEGER BGND; 	α BACKGROUND FACE;
01100		DEFINE #POTNTF="5";	α POTENTIALLY VISIBLE FACES;
01200		DEFINE #POTNTE="1";	α POTENTIALLY VISIBLE EDGES;
01300		DEFINE #FOLDE ="2";	α FOLDED POTENTIALLY VISIBLE EDGES;
01400		DEFINE #PIPE="3";	α VISIBLE INCOMPLETE FOLDED EDGES;
01500	
01600	α OCCULTATION ROUTINES;
01700	
01800		XSUBR POTEN.(ITG E);
01900		XSUBR HIDE.(ITG E);
02000		XSUBR VISIB.(ITG E);
02100		XSUBR FOLD.(ITG E);
02200		XSUBR UFACE.(ITG Q,E,V);XISUBR UFACE(ITG E,V);
02300		BSUBR FOLDED(ITG E);RETURN('100 LAND CAR(E));
02400		BSUBR VISIBLE(ITG E);RETURN('40 LAND CAR(E));
02500		BSUBR POTENT(ITG E);RETURN('20 LAND CAR(E));
02600		XSUBR TJUT.(ITG E);	XISUBR TJUT(ITG E);
02700		XSUBR TJOT.(ITG E);	XISUBR TJOT(ITG E);
02800					XISUBR TJ(ITG E);
02900		XISUBR COMPEE(ITG E1,E2); EXTERNAL REAL XCROSS,YCROSS,EPSLON;
03000	
03100	α GEOMETRIC ROUTINES;
03200	
03300		XRSUBR QFEV(ITG F,E,V);
03400		XRSUBR QEV(ITG E,V);
03500		XSUBR  CROSSING(REFERENCE REAL X,Y;ITG E1,E2);
03600		XRSUBR ZDEPTH(ITG F,V);
03700		XRSUBR ZDALT (ITG F; REAL X,Y);
03800	
03900	α STATISTICS;
04000		ITG FOLDSCANS,FACESCANS;
04100		EXTERNAL ITG CEECNT,FOLDCNT,EDGECNT;
04200	XSUBR PVHID.(ITG E);XISUBR PVHID(ITG E); XSUBR PVHIDZ(ITG E);
04300	XSUBR NVHID.(ITG E);XISUBR NVHID(ITG E); XSUBR NVHIDZ(ITG E);
04400	XSUBR E.HIDE(ITG F,E,V);
04500	XSUBR E.SHOW(ITG F,E,V);
     

00100	α VERIFICATON DISPLAY SUBR;
00200		EXTERNAL STRING SUBR ISTR(ITG I);
00300		REQUIRE "DPYIII" SOURCE_FILE;
00400		SAFE INTEGER ARRAY DPYBUF[1:200];
00500		EXTERNAL ITG VERNX,VERNY;
00600	
00700	INTERNAL SUBR DPYE (ITG E);
00800	BEGIN "DPYE"
00900		ITG V1,V2;
01000		REAL X1,Y1,X2,Y2;
01100		V1 ← PVT(E); V2 ← NVT(E);
01200		X1 ← XDC(V1); Y1 ← YDC(V1);
01300		X2 ← XDC(V2); Y2 ← YDC(V2);
01400		AIVECT((X1+X2)/2+VERNX,(Y1+Y2)/2+VERNY);
01500		DPYBIG(1);DPYSST(ISTR(E));
01600		DPYBRT(3);AIVECT(X1,Y1);AVECT(X2,Y2);DPYBRT(2);
01700	END "DPYE";
01800	
01900	INTERNAL SUBR DPYF (ITG F);
02000	BEGIN "DPYF"
02100		REAL X0,Y0; ITG X1,Y1,X2,Y2; ITG I,E,E0,V,V1,V2;
02200		IF F=BGND THEN ⊂ AIVECT(0,-350);DPYSST("BGND");RETURN;⊃;
02300		X0←Y0←I←0;
02400		E0←E←PED(F);DPYBRT(3);
02500		DO ⊂ V←VCCW(E,F);X0←X0+XDC(V);Y0←Y0+YDC(V);INCREM(I);
02600		V1←PVT(E);V2←NVT(E);
02700		X1←XDC(V1);Y1←YDC(V1);X2←XDC(V2);Y2←YDC(V2);
02800		AIVECT(X1,Y1);AVECT(X2,Y2);
02900		E←ECCW(E,F);
03000		⊃ UNTIL E=E0;DPYBRT(2);
03100		AIVECT(X0/I,Y0/I);DPYBIG(1);DPYSST(ISTR(F));
03200	END "DPYF";
03300	
03400	INTERNAL SUBR DPYV(ITG V);
03500	BEGIN "DPYV"
03600		AIVECT(XDC(V)+VERNX,YDC(V)+VERNY);
03700		DPYBIG(1);DPYSST(ISTR(V));
03800	END "DPYV";
     

00100	α SINGLE-STEP VERIFICATION OUTPUT;
00200	INTERNAL SUBR OSTR(STRING S);
00300	BEGIN	"OSTR"
00400		INTEGER CHR,ISTEP,JSTEP,BRK; STRING STR;
00500		INCREM(ISTEP);
00600		OUTSTR(CVS(ISTEP)&"."&9&S&↓);
00700		AIVECT(-400,420);DPYBIG(4);
00800		DPYSST(S);DPYOUT(3);
00900		IF CHR="J"∧(ISTEP<JSTEP) THEN RETURN;
01000		IF 0≤CHR ∧ CHR<'175 THEN
01100		CHR ← INCHRW ELSE CHR←INCHRS;
01200		IF CHR="J" THEN 
01300		⊂ STR←INCHWL;JSTEP←INTSCAN(STR,BRK);RETURN;⊃;
01400	END	"OSTR";
01500	
01600	α VERIFICATION DISPLAY;
01700		DEFINE !="DPYSET(DPYBUF)",$="&"",""&",$$="&"")"" ";
01800	INTERNAL PROCEDURE DPYALL;
01900	BEGIN "DPYALL"
02000		LABEL L1,L2;
02100		REAL X1,Y1,X2,Y2;
02200		ITG B,E,V1,V2;
02300		EXTERNAL ITG ARRAY DPYBUF[1:1500];
02400		DPYSET(DPYBUF);
02500		B←WORLD;
02600	L1:	B←PBODY(B);IF BTYPE(B) THEN ⊂ E←B;
02700	L2:	E←PED(E);IF ETYPE(E) THEN ⊂
02800		IF VISIBLE(E)∨POTENT(E) THEN ⊂
02900		V1←PVT(E);V2←NVT(E);
03000		X1←XDC(V1);Y1←YDC(V1);X2←XDC(V2);Y2←YDC(V2);
03100		AIVECT(X1,Y1);AVECT(X2,Y2);⊃;
03200	GO L2;⊃;
03300	GO L1;⊃;
03400		DPYOUT(2);
03500	END "DPYALL";
     

00100	SUBR MKTJ2 (ITG FOLD,EDGE,Q);
00200	BEGIN	"MKTJ2"
00300		ITG Q1,Q2,V;
00400		XISUBR EBREAK(ITG E);
00500		XSUBR JFUSE(ITG J1,J2);
00600		ITG F,JUT,EJUT,JOT,EJOT;
00700	
00800	α SPLIT 'EM;
00900		Q1 ← (Q LSH -6)LAND 3;
01000		Q2 ← (Q LSH -3)LAND 3;
01100		JOT ← (CASE Q1 OF
01200			(EBREAK(FOLD), PVT(FOLD), NVT(FOLD), NVT(FOLD)));
01300		JUT ← (CASE Q2 OF
01400			(EBREAK(EDGE), PVT(EDGE), NVT(EDGE), NVT(EDGE)));
01500		JFUSE(JUT,JOT);
01600	
01700	α DISTINGUISH OVER AND UNDER;
01800		IF ZPP(JUT)>ZPP(JOT) THEN ⊂ EDGE↔FOLD;JUT↔JOT;Q1↔Q2;⊃;
01900	α EDGE WHOLE - HIDE IT ALL OR NOTHING;
02000	α BROKEN EDGE - HIDE HALF OF IT;
02100		V ← OTHER(EDGE,JUT);
02200		F ← PFACE(FOLD);
02300		EJUT ← (IF Q2 THEN EDGE ELSE PED(JUT));
02400		IF QFEV(F,FOLD,V)>0 THEN EDGE↔EJUT ELSE
02500		IF Q2 THEN RETURN;
02600		E.HIDE(F,EJUT,JUT);
02700	END	"MKTJ2";
     

00100	α VERTEX V HAS JUST BEEN HIDDEN UNDER FACE F;
00200		FORWARD BSUBR WITHIN(ITG F,V);
00300	SUBR VHIDE (ITG F,V);
00400	BEGIN	"VHIDE"
00500		ITG E,E0,U,V0;
00600		REAL Z;
00700		IF ¬POTENT(V) THEN RETURN;
00800		β !;β DPYF(F);β DPYV(V);
00900		β OSTR("VHIDE("&ISTR(F) $ ISTR(V) $$);
01000		IF ¬WITHIN(F,V) THEN ⊂ OUTSTR("VHIDE WITHIN FAILURE !!!"&↓);
01100		INCHRW;RETURN;⊃;
01200	
01300		Z ← ZDEPTH(F,V);
01400		V0←V;
01500		DO ⊂ IF Z > ZPP(V) THEN
01600	BEGIN
01700		HIDE.(V);
01800		E0 ← E ← PED(V);
01900		DO ⊂ IF POTENT(E) THEN E.HIDE(F,E,V)⊃ UNTIL E0=(E←ECCW(E,V));
02000	END ⊃ UNTIL V0=(V←TJOINT(V));
02100	END "VHIDE";
     

00100	SUBR EHIDE;
00200	BEGIN	"EHIDE"
00300		LABEL L0;
00400		ITG F,F2,EDGE,E,E0,V1,V2,A,Q,QV;
00500	
00600	α LOOK IN THE PIPE;
00700	L0:	IF EMPTY(WORLD,#PIPE) THEN RETURN;
00800		A ← CDR(WORLD+#PIPE); EDGE ← ALT(A);
00900		IF PVHID(EDGE) THEN 
01000		⊂ V1 ← PVT(EDGE);V2 ← NVT(EDGE);QV←'200;PVHIDZ(EDGE);⊃ ELSE
01100		IF NVHID(EDGE) THEN 
01200		⊂ V1 ← NVT(EDGE);V2 ← PVT(EDGE);QV←'100;NVHIDZ(EDGE);⊃ ELSE
01300		IF POTENT(EDGE) THEN RETURN;
01400		RINGO(A,#PIPE);IF ¬POTENT(EDGE) THEN GO L0;
01500		PED.(EDGE,V1);
01600	α INITIALIZATION;
01700		F←UFACE(EDGE,V1);
01800		IF F=0 THEN FATAL("OVER FACE MISSING - EHIDE");
01900		E←E0←PED(F);
02000	
02100	α DIAGONOSTIC DISPLAY;
02200		β !;β DPYF(F);β DPYE(EDGE);β DPYV(V1);
02300		β OSTR("EHIDE("&ISTR(F) $ ISTR(EDGE) $ ISTR(V1) $$);
02400	
02500	α CLOCK AROUND OVER FACE'S EDGES A'LOOK'N FOR A CROSSING;
02600	DO BEGIN
02700		Q←COMPEE(EDGE,E);
02800		IF (Q≥0) THEN 
02900		IF (Q LAND '441)='441 THEN 
03000	BEGIN
03100		F2←OTHER(E,F);
03200		IF ¬POTENT(F2) THEN
03300		⊂ MKTJ2(E,EDGE,Q); EDGE ← PED(V1); HIDE.(EDGE); β DPYALL; GO L0;⊃;
03400		IF (Q LAND '441)='441 THEN ⊂ E0←E;F←F2;⊃;
03500	END ELSE IF (Q LAND QV) THEN ⊂ HIDE.(EDGE);β DPYALL;GO L0;⊃;
03600		E ← ECCW(E,F);
03700	END UNTIL E0=E;
03800	
03900	α EDGE NEVER LEFT F AND SO IT BE HIDDEN;
04000		HIDE.(EDGE);
04100		β DPYALL;
04200		VHIDE(F,V2);
04300		GO L0;
04400	END "EHIDE";
     

00100	α VSOLVE - TRY TO HIDE THE POTENTIAL EDGES OF V UNDER THE FACES OF V;
00200	SUBR VSOLVE (ITG UF,V);
00300	BEGIN	"VSOLVE"
00400		ITG I,I0,J,J0,E,E0,U,S0,S1,S2,F,F0,CUF;
00500		LABEL L0,L1,L2,L3,L1A,L3A;
00600		REAL Z0,Z1,Q1,Q2,ZI,ZJ;
00700	
00800	α FOR ALL THE EDGES OF THE VERTEX;
00900		J0 ← J ← V;
01000	L0:	E ← E0 ← PED(J);ZJ←ZPP(J); GO L1A;
01100	L1:	E←ECCW(E,J); IF E=E0 THEN
01200		⊂ J←TJOINT(J); IF J=J0 THEN RETURN ELSE GO L0;⊃;
01300	L1A:	IF ¬POTENT(E) THEN GO L1;
01400		U ← OTHER(E,J); Z0 ← ZPP(U);
01500	
01600	α FOR ALL THE FACES OF THE VERTEX;
01700		I0 ← I ← V;
01800	L2:	S0 ← S1 ← PED(I);ZI←ZPP(I);S2 ← ECCW(S1,I); GO L3A;
01900	L3:	S1←S2;  S2←ECCW(S1,I);  IF S1=S0 THEN
02000		⊂ I←TJOINT(I); IF I=I0 THEN GO L1 ELSE GO L2;⊃;
02100	L3A:	F←FCCW(S1,I);
02200		IF ¬POTENT(F)∨(E=S1)∨(E=S2) THEN GO L3;
02300	
02400	α TEST FOR FACE-EDGE OVERLAP;
02500		IF QFEV(F,S1,U)>0 ∧ QFEV(F,S2,U)>0 THEN
02600	BEGIN
02700		Z1 ← ZDEPTH(F,U);
02800		IF ((I=J)∧(Z1>Z0)) ∨ (ZI>ZJ) THEN 
02900		⊂ E.HIDE(F,E,J);GO L1;⊃;
03000		IF FOLDED(E) THEN ⊂
03100		CUF ← UFACE(E,J);
03200		IF CUF=0 ∨ CUF=UF ∨ ((I=J)∧Z1>ZDEPTH(CUF,U))∨(ZJ>ZI) THEN UFACE.(F,E,J);⊃;
03300	END;
03400		GO L3;
03500	END "VSOLVE";
     

00100	α VSHOW  -  VERTEX V IS IN VIEW ABOVE FACE UF;
00200	SUBR VSHOW (ITG UF,V);
00300	BEGIN	"VSHOW"
00400		ITG F,E,E0;
00500		INTEGER I;
00600		β !;β DPYV(V);
00700		β OSTR("VSHOW("&ISTR(UF) $ ISTR(V) $$);
00800	
00900	α E.SHOW THE POTENT FOLDS OF V - PROMULGATE UNDERFACE;
01000		VISIB.(V);
01100		E←E0←PED(V);
01200		DO ⊂ IF FOLDED(E)∧POTENT(E) THEN E.SHOW(UF,E,V) ⊃
01300		UNTIL E0=(E←ECCW(E,V));
01400		VSOLVE(UF,V);
01500		EHIDE;
01600	
01700	END "VSHOW";
     

00100	α SHOW AS MUCH OF AN EDGE (WHICH HAPPENS TO BE A FOLD) AS YOU CAN;
00200		FORWARD ISUBR FACESCAN (ITG V);
00300	α V1 IS ALREADY VISIBLE, UF IS THE EDGE'S UNDER FACE WRT V1;
00400	SUBR ESHOW (ITG EDGE,V1);
00500	BEGIN	"ESHOW"
00600		ITG UF,Q;
00700		REAL X,Y,X0,Y0,Z1,Z2;
00800		ITG V,V2,U1,U2,J1,J2;
00900		ITG FOLD,FOLD0,E,E0,NEAR,E1,E2,EUF;
01000		REAL Q1,Q2,R,RMIN;
01100		β !;β DPYE(EDGE);β DPYV(V1);
01200		β OSTR("ESHOW("&ISTR(EDGE) $ ISTR(V1) $$);
01300	α PICK'EM UP;
01400		V2 ← OTHER(EDGE,V1);
01500		UF ← UFACE(EDGE,V1);
01600		IF UF=0 THEN ⊂ OUTSTR("WARNING: UF=0 IN ESHOW"&↓);INCHRW;
01700		UF←FACESCAN(V1);UFACE.(UF,EDGE,V1);⊃;
01800		PED.(EDGE,V1);
01900	
02000	α CHECK FOR SIDE OF EXIT FROM UNDERFACE;
02100		IF UF≠BGND THEN
02200	BEGIN	E ← E0 ← PED(UF);
02300	DO BEGIN
02400		Q ← COMPEE(EDGE,E);
02500		IF (Q>0)∧(Q LAND '441)='441 THEN ⊂ MKTJ2(EDGE,E,Q);EHIDE;DONE;⊃;
02600		E ← ECCW(E,UF);
02700	END UNTIL E=E0; END;
02800		EDGE ← PED(V1);
02900		V2 ← OTHER(EDGE,V1);
03000	
03100	α MAKE THE EDGE VISIBLE AND PROMULGATE ITS UNDERFACE;
03200		VISIB.(EDGE);
03300		UFACE.(UF,EDGE,V2);
03400		IF ¬VISIBLE(V2) THEN VSHOW(UF,V2);
03500	END "ESHOW";
     

00100	BSUBR WITHIN (ITG F,V);
00200	BEGIN "WITHIN"
00300		ITG E,E0;
00400		E ← E0 ← PED(F);
00500		IF V=VCW(E,F) THEN RETURN(FALSE);
00600		DO ⊂ 
00700			IF V=VCCW(E,F) ∨ QFEV(F,E,V)<0 
00800			THEN RETURN(FALSE);
00900			E ← ECCW(E,F);
01000		⊃ UNTIL E=E0;
01100		RETURN(TRUE);
01200	END "WITHIN";
01300	
01400	ISUBR FACESCAN (ITG V);
01500	BEGIN	"FACESCAN"
01600		REAL Z0,Z1,ZMAX;
01700		ITG F,FMAX,F0,F1,F2;
01800		FMAX ← BGND;
01900		ZMAX ← -9@9;
02000		Z0 ← ZPP(V);
02100		F1 ← F2 ← PFACE(PED(V));
02200		IF TJ(V) THEN F2 ← PFACE(PED(TJOINT(V)));
02300		F←F0←WORLD;
02400		INCREM(FACESCANS);
02500	WHILE TRUE DO 
02600	BEGIN "FSCAN"
02700		LABEL L;
02800		F ← CDR(F+#POTNTF);
02900		IF F=F0 THEN DONE;
03000	L:	IF F≠F1 ∧ F≠F2 ∧ WITHIN(F,V) THEN
03100		BEGIN
03200			Z1 ← ZDEPTH(F,V);
03300			IF Z1>Z0 THEN RETURN(F);
03400			IF Z1>ZMAX THEN ⊂ ZMAX←Z1; FMAX←F ⊃;
03500		END;
03600	END "FSCAN";
03700		β !;β DPYF(FMAX);β DPYV(V);
03800		β OSTR("FACESCAN RETURNS FMAX = "&ISTR(FMAX));
03900		RETURN(FMAX);
04000	END "FACESCAN";
     

00100	SUBR FOLDSCAN;
00200	BEGIN "FOLDSCAN"
00300		LABEL L0; ITG AFOLD,FOLD,AFOLD0,FOLD0,Q;
00400		AFOLD0 ← CDR(WORLD+#FOLDE);
00500	L0:	IF AFOLD0=WORLD THEN RETURN;
00600		FOLD0 ← ALT(AFOLD0);
00700		AFOLD ← CDR(AFOLD0+#FOLDE);
00800	WHILE TRUE DO
00900	BEGIN
01000		IF AFOLD=WORLD THEN DONE;
01100		FOLD ← ALT(AFOLD);
01200		IF POTENT(FOLD) THEN ⊂
01300		INCREM(FOLDSCANS);
01400		Q ← COMPEE(FOLD,FOLD0);
01500		IF (Q>0)∧(Q LAND '441)='441 THEN 
01600			⊂ MKTJ2(FOLD,FOLD0,Q);EHIDE;⊃;⊃;
01700		AFOLD ← CDR(AFOLD+#FOLDE);
01800	END;
01900		AFOLD0 ← CDR(AFOLD0+#FOLDE);
02000		GO L0;
02100	END "FOLDSCAN";
02200	
     

00100	SUBR VSCAN;
00200	BEGIN "VSCAN"
00300		ITG B,V;
00400		LABEL L1,L2;
00500		B ← WORLD;
00600	L1:	B ← PBODY(B); IF B=WORLD THEN RETURN;
00700		V ← B;
00800	L2:	V ← PVT(V); IF V=B THEN GO L1;
00900		IF POTENT(V) THEN VSOLVE(0,V);
01000		GO L2;
01100	END "VSCAN";
     

00100	INTERNAL SUBR OCCULT;
00200	BEGIN	"OCCULT"
00300		ITG F,E,V,A;
00400		INTEGER TIME1,TIME2;
00500		TIME1	←	CALL(0,"RUNTIM");
00600		TIME2	←	CALL(0,"MSTIME");
00700		CEECNT ← FOLDSCANS ← FACESCANS ← 0;
00800	
00900	α MAIN SCAN;
01000		VSCAN; EHIDE;
01100		FOLDSCAN;
01200		WHILE ¬EMPTY(WORLD,#FOLDE) DO
01300	BEGIN
01400		WHILE ¬EMPTY(WORLD,#PIPE) DO
01500		BEGIN
01600			EHIDE;
01700			E ← CAR(WORLD+#PIPE); RINGO(E,#PIPE);
01800			E ← ALT(E); IF POTENT(E) THEN
01900			IF ¬POTENT(V←PVT(E)) THEN ESHOW(E,V) ELSE
02000			IF ¬POTENT(V←NVT(E)) THEN ESHOW(E,V) ELSE
02100				FATAL("BAD E IN PIPE.");
02200		END;
02300		IF ¬EMPTY(WORLD,#FOLDE) THEN
02400		BEGIN
02500			A ← CDR(WORLD+#FOLDE); E←ALT(A);
02600			IF ¬POTENT(E) THEN RINGO(A,#FOLDE) ELSE
02700			⊂ V ← PVT(E);
02800			IF ¬POTENT(V) THEN V←NVT(E);
02900			IF ¬POTENT(V) THEN FATAL("BAD FOLD IN FOLDE");
03000			F ← FACESCAN(V);
03100			IF ZDEPTH(F,V) > ZPP(V) 
03200			THEN VHIDE(F,V)
03300			ELSE VSHOW(F,V);⊃;
03400		END;
03500	END;
03600	
03700	α PROMOTE REMAINING POTENT EDGES TO VISIBLE;
03800	α ∀ E|EεPOTNTE DO IF POTENT(E) THEN VISIB.(E);
     

00100	BEGIN
00200		EXTERNAL REAL SUBR LOG (REAL X);
00300	STRING SUBR TIMSTR (ITG T);
00400	BEGIN "TIMSTR"
00500		STRING S;
00600		SETFORMAT(0,3);IF T<1000 THEN RETURN(CVS(T)&" MSEC.");
00700		S ← CVS(T%60000)&":";
00800		SETFORMAT(-2,3);
00900		S ← S & CVS((T MOD 60000)%1000);
01000		T ← T MOD 1000;
01100		SETFORMAT(-3,3);
01200		S ← S & "."&CVS(T);
01300		RETURN(S);
01400	END "TIMSTR";
01500		TIME1	←	CALL(0,"RUNTIM") - TIME1;
01600		TIME2	←	CALL(0,"MSTIME") - TIME2;
01700		!;DPYBIG(1);DPYBRT(2);
01800		AIVECT(-20,450);DPYSST("RUN  TIME "&TIMSTR(TIME1));
01900		AIVECT(-20,430);DPYSST("REAL TIME "&TIMSTR(TIME2));
02000		AIVECT(-20,410);SETFORMAT(0,7);
02100		DPYSST("TIME SHARE "&CVS(100 MIN (100*TIME1/TIME2))&" %");
02200	
02300		AIVECT(-420,450);DPYSST(CVS(FACESCANS)&" FACESCANS");
02400		AIVECT(-420,430);DPYSST(CVS(FOLDSCANS)&" FOLDSCANS");
02500		AIVECT(-420,410);DPYSST(CVS(CEECNT   )&" COMPARES");
02600	
02700		AIVECT(-200,450);DPYSST(CVS(FOLDCNT)&" FOLDS");
02800		AIVECT(-200,430);DPYSST(CVS(FOLDCNT↑2)&" FOLDS↑2");
02900		AIVECT(-200,410);DPYSST(CVG(LOG(2*CEECNT)/LOG(FOLDCNT)));
03000		AIVECT(-200,390);DPYSST(CVS(EDGECNT)&" EDGES");
03100	
03200		DPYOUT(3);
03300	END;
03400	END	"OCCULT";
     

00100	INTERNAL SUBR KLJOTS;
00200	BEGIN "KLJOTS"
00300		ITG B,V,VV;
00400		B ← WORLD;
00500		WHILE WORLD≠(B←PBODY(B)) DO ⊂
00600		V←NVT(B);
00700		WHILE TJ(V) DO ⊂
00800		VV←V; V←NVT(V);
00900		IF TJOT(VV)∧('100000 LAND(TYPE(VV))) THEN KLEV(VV);⊃;⊃;
01000	END "KLJOTS";
01100	
01200	INTERNAL SUBR KLJUTS;
01300	BEGIN "KLJUTS"
01400		ITG B,V,VV;
01500		B ← WORLD;
01600		WHILE WORLD≠(B←PBODY(B)) DO ⊂
01700		V←NVT(B);
01800		WHILE TJ(V) DO ⊂
01900		VV←V; V←NVT(V);
02000		IF TJUT(VV)∧('100000 LAND(TYPE(VV))) THEN KLEV(VV);⊃;⊃;
02100	END "KLJUTS";
02200	
02300	INTERNAL SUBR KLTEMP;
02400	BEGIN "KLTEMP"
02500		ITG B,E,V,EE,VV;
02600		B ← WORLD;
02700		WHILE WORLD≠(B←PBODY(B)) DO ⊂
02800		E←NED(B);
02900		WHILE E≠B DO ⊂
03000		EE←E;E←NED(E);IF ('100000 LAND TYPE(EE))≠0 THEN KLFE(EE);⊃;
03100		V←NVT(B);
03200		WHILE V≠B DO ⊂
03300		VV←V;V←NVT(V);IF ('100000 LAND TYPE(VV))≠0 THEN KLEV(VV);⊃;⊃;
03400	END "KLTEMP";
03500	END;
03600	DPY - EOF.